home *** CD-ROM | disk | FTP | other *** search
/ The Best of MacTutor - S…e Code for Volumes 1 to 5 / The Best of MacTutor - Source Code for Volume 1-5 (Wayzata Technology)(6031)(1990).bin / Source Code / #29 (Feb 88) / scsi forth driver / Scsidisk2.fth
Text File  |  1987-12-18  |  24KB  |  904 lines
  1. only forth definitions
  2. also mac also assembler
  3.  
  4. CODE SCALE
  5.     MOVE.L   (A6)+,D0
  6.     BMI.S    @1
  7.     MOVE.L   (A6),D1
  8.     ASL.L    D0,D1
  9.     MOVE.L   D1,(A6)
  10.     RTS
  11. @1  MOVE.L   (A6),D1
  12.     NEG.L    D0
  13.     ASR.L    D0,D1
  14.     MOVE.L   D1,(A6)
  15.     RTS
  16. END-CODE
  17.  
  18. : 4ASCII 0
  19.     4 0 DO    8 SCALE 0 WORD 1+ C@ +    LOOP
  20. ;
  21.  
  22. ( *** compiler support words for external definitions *** )
  23. : :xdef 
  24.     create     -4 allot
  25.         $4EFA w, ( JMP )
  26.         0 w,     ( entry point to be filled later )
  27.         0 ,      ( length of routine to be filled later )
  28.         here 6 - 76543
  29. ;
  30.  
  31. : ;xdef { branch marker entry | -- }
  32.     marker 76543 <> abort" xdef mismatch"
  33.     entry branch - branch w!
  34.     here branch - 2+ branch 2+ !
  35. ; 
  36.     
  37. : xlen 4 + @ ; ( get length word of external definition )
  38.  
  39. ( *** driver header block *** )
  40.  
  41.  0 CONSTANT drvrFlags
  42.  2 CONSTANT drvrdelay 
  43.  4 CONSTANT drvrEMask
  44.  6 CONSTANT drvrMenu
  45.  8 CONSTANT drvrOpen
  46. 10 CONSTANT drvrPrime
  47. 12 CONSTANT drvrCtl
  48. 14 CONSTANT drvrStatus
  49. 16 CONSTANT drvrClose
  50. 18 CONSTANT drvrname
  51. 50 CONSTANT DAlength
  52.  
  53. ( *** compiler support words for DA and driver definitions *** )
  54. : :DA 
  55.     create     -4 allot
  56.         here 87654 ( start of DA block, and marker )
  57.         54 allot   ( length of block )
  58. ;
  59.  
  60. : ;DA { DAstart marker Ropen Rprime Rctl Rstatus Rclose
  61.         Rflags Rdelay Remask Rmenu Rname | -- }
  62.     marker 87654 <> abort" DA definition mismatch"
  63.     Ropen     DAStart - DAStart drvrOpen + w!
  64.     Rprime     DAStart - DAStart drvrPrime + w!
  65.     Rctl         DAStart - DAStart drvrCtl + w!
  66.     Rstatus     DAStart - DAStart drvrStatus + w!
  67.     Rclose     DAStart - DAStart drvrClose + w!
  68.     Rflags          DAStart drvrFlags + w!
  69.     Rdelay          DAStart drvrDelay + w!
  70.     Remask          DAStart drvrEmask + w!
  71.     RMenu              DAStart drvrMenu + w!
  72.     Rname count dup      DAStart drvrName + c!
  73.         DAStart drvrName + 1+ swap 
  74.         dup 31 > if drop 31 then cmove 
  75.     here DAstart -       DAStart DAlength + !
  76. ; 
  77.     
  78. : DAlen DAlength + @ ; ( get length word of external definition )
  79.  
  80. \ —————————————————————————————————————
  81. \ some macros needed in the driver
  82. \ —————————————————————————————————————
  83.  
  84. CODE xchg ( exchange word halves on top of stack )
  85.     move.l (a6)+,d1
  86.     swap.w d1
  87.     move.l d1,-(a6)
  88.     rts
  89. END-CODE MACH
  90.     
  91. CODE min
  92.     MOVE.L    (A6)+,D0                            
  93.     CMP.L     (A6),D0                             
  94.     BGE.S     @1        
  95.     MOVE.L    D0,(A6)                             
  96. @1    RTS 
  97. END-CODE MACH
  98.  
  99. CODE shl ( data #bits )
  100.     MOVE.L (A6)+,D0
  101.     MOVE.L (A6),D1
  102.     LSL.L  D0,D1
  103.     MOVE.L D1,(A6)
  104.     RTS
  105. END-CODE    MACH
  106.  
  107. CODE shr ( data #bits )
  108.     MOVE.L (A6)+,D0
  109.     MOVE.L (A6),D1
  110.     LSR.L  D0,D1
  111.     MOVE.L D1,(A6)
  112.     RTS
  113. END-CODE    MACH
  114.  
  115. CODE w*
  116.     MOVE.L (A6)+,D1
  117.     MOVE.L (A6)+,D0
  118.     MULS.W D1,D0
  119.     MOVE.L D0,-(A6)
  120.     RTS
  121. END-CODE MACH
  122.  
  123. \ —————————————————————————————————————
  124. \ **** DA glue macros
  125. \ —————————————————————————————————————
  126.  
  127. $8FC CONSTANT JioDone 
  128.  
  129. CODE DA.prelude
  130.     LINK    A6,#-512         ( 512 bytes of local Forth stack )
  131.     MOVEM.L A0-A1,-(A7)        ( save registers )
  132.     MOVE.L  A6,A3            ( setup local loop return stack )
  133.     SUBA.L  #256,A3            ( in the low 256 local stack bytes )
  134.     MOVE.L  A0,-(A6)         ( parameter block )
  135.     MOVE.L  A1,-(A6)        ( device control entry )
  136.     RTS            \ just to indicate the MACHro stops here 
  137. END-CODE MACH
  138.  
  139. CODE DA.epilogue
  140.     MOVE.L  (A6)+,D0        ( return code )
  141.     MOVEM.L (A7)+,A0-A1    ( restore registers )
  142.     UNLK    A6
  143.     RTS
  144. END-CODE MACH
  145.  
  146. CODE DA.JIODone
  147.     MOVE.L  (A6)+,D0        ( return code )
  148.     MOVEM.L (A7)+,A0-A1    ( restore registers )
  149.     UNLK    A6
  150.     move.l    JIODone,A0
  151.     movem.l d4-d7/a4-a6,-(a7)
  152.     jsr        (a0)
  153.     movem.l    (a7)+,d4-d7/a4-a6
  154.     RTS
  155. END-CODE MACH
  156.  
  157. .trap    _newptr,sys,clr    $A71E
  158.  
  159. \ fields of device control entry
  160.  4 CONSTANT dCtlFlags
  161.  6 CONSTANT dCtlQHdr
  162. 16 CONSTANT dCtlPosition
  163. 20 CONSTANT dCtlStorage
  164. 24 CONSTANT dCtlRefNum
  165. 26 CONSTANT dCtlCurTicks
  166. 30 CONSTANT dCtlWindow
  167. 34 CONSTANT dCtlDelay
  168. 36 CONSTANT dCtlEMask
  169. 38 CONSTANT dCtlMenu
  170.  
  171. \ parameter block constants
  172.  
  173. 0   CONSTANT  qLink        \ pointer to next queue entry [long word]
  174. 4   CONSTANT  qType        \ queue type [word]
  175. 6   CONSTANT  ioTrap        \ routine trap [word]
  176. 7   CONSTANT  ioTrap+1        \ read or write command
  177. 8   CONSTANT  ioCmdAddr        \ routine address [long word]
  178. 12  CONSTANT  ioCompletion    \ addr of completion routine [long word]
  179. 16  CONSTANT  ioResult        \ result code returned here [word]
  180. 18  CONSTANT  ioNamePtr        \ holds pointer to file name string or
  181. 22  CONSTANT  ioVRefNum        \ volume reference number
  182. 26  CONSTANT  csCode        ( type of control call )
  183. 28  CONSTANT  csParam        ( control call parameters )
  184.  
  185. \ MFS I/O Parameter Block
  186. 24 CONSTANT    ioRefNum
  187. 26 CONSTANT    ioVersNum
  188. 27 CONSTANT    ioPermssn
  189. 28 CONSTANT    ioMisc
  190. 32 CONSTANT    ioBuffer
  191. 36 CONSTANT    ioReqCount
  192. 40 CONSTANT    ioActCount
  193. 44 CONSTANT    ioPosMode
  194. 46 CONSTANT    ioPosOffset
  195. 50 CONSTANT IOParamBlkSize
  196.  
  197. 4ascii SDRV constant "sdrv
  198. 4ascii TFS1 constant "tfs1
  199.  
  200.  
  201. \ Equates
  202. \ My excuses for the format. This has been taken almost
  203. \ 'as is' from Apple's SCSI driver example. - jl -
  204.  
  205. EQU    verChar    $34    \ version '4'
  206. EQU    SCSIZE    10     \ size of SCSI extended command
  207.  
  208. \ Equates for our storage (pointed to by DCtlStorage)
  209. EQU    Offset    0               \ [long] offset of starting sector
  210. EQU    MyDQEl        Offset+4        \ [20 bytes] drive queue element (with flags) for this drive
  211. EQU    MyDrvNum    MyDQEl+20       \ [word] drive num (determined by scanning drive queue)
  212. EQU    NextAddr    MyDrvNum+2      \ [long] ptr to current block buffer
  213. EQU    TickleFlag    NextAddr+4      \ [byte] Do we need to remind the system about this drive?
  214. EQU    BlindOK        TickleFlag+1    \ [byte] Can we use blind reads?
  215.             \ I left this in to keep the format the same. 
  216.             \ We don't need it since our driver does not read blind.
  217.  
  218. EQU    SCmd        BlindOK+1       \ [10 bytes] SCSI extended cmd Block /JL
  219. EQU    StatWord    SCmd+10         \ [word] status and message bytes...
  220. EQU    MsgWord        StatWord+2      \ [word] ... returned by SCSIComplete
  221.  
  222. EQU    OurID        MsgWord+2 \ [word] our SCSI ID
  223. EQU    SCSIPseudo    OurID+2         \ [30 bytes] SCSI pseudo-code program - three instructions long
  224. EQU    SCSIPar1    SCSIPseudo+2    \ first SCSI code parameter (long)
  225. EQU    SCSIPar2    SCSIPar1+4        \ 2nd SCSI code parameter (long)
  226. EQU    DiskVarLth    SCSIPseudo+(SCSIZE*3) \ length of our locals . . .
  227. EQU DQDrvSize    12
  228.  
  229. EQU realSize    MyDQEl+DQDrvSize+4
  230.  
  231. \ equates for CSParam offsets for our special control call
  232. EQU    DSCCmd        CSParam        \ Ptr to SCSI command block
  233. EQU    DSCPseudo    DSCCmd+4        \ Ptr to SCSI pseudocode (if any bytes to xfer)
  234. EQU    DSCBuffer    DSCPseudo+4        \ Ptr to buffer for transfer (if any)
  235. EQU    DSCSize        DSCBuffer+4        \ Size of transfer, signed (+ if read, - if write)
  236. EQU    DSCTicks    DSCSize+4        \ Tick count we're willing to wait for completion
  237. EQU    DSCCmdSize    DSCTicks+4        \ (word) Size of command block we're sending (usually 6)
  238.  
  239. EQU KillCode    1 
  240. EQU    VerifyCode    5
  241. EQU    FormatCode    6
  242. EQU    EjectCode    7
  243. EQU    IconCode    21
  244. EQU AccRun        65
  245. EQU    SCSICode    77      \ our own special code (defined above)
  246.  
  247. EQU    ControlErr    -1
  248. EQU    StatusErr    -1
  249. EQU    ParamErr    -50
  250. EQU    nsDrvErr    -56
  251. EQU    nsVErr        -35
  252. EQU    ioErr        -36
  253.  
  254. EQU    dNeedTime    $DFFF    \ to clear bit 5 of high byte in drvrFlags
  255.  
  256. EQU    DiskInsertEvt    7
  257. EQU SysEvtMask    $144
  258. EQU UTableBase    $11C
  259. EQU DrvQHdr        $308
  260. EQU QHead        $2
  261.  
  262. EQU    DQDrive        6
  263. EQU    DQRefNum    8
  264. EQU    DQFSid        10
  265.  
  266. EQU    PDSig        0
  267. EQU    PDSigWord    $5453
  268. EQU    PDFSID        8
  269. EQU    PDLen        12
  270.  
  271. \ _______________________________________________________________________
  272. \ The code starts here.
  273. \ _______________________________________________________________________
  274.  
  275. :XDEF    ScsiDisk  \ compiles a jump to the install code at the end 
  276.           \ which will be resolved at the end of the definition.
  277.  
  278. :DA    DiskDrvr  \ this word provides the driver header structure
  279.         .ALIGN
  280.  
  281. \ Q200 Icon, as given by Quantum
  282. \ If you find this 'snail' ugly, feel free to change it ...
  283. \  J.L.
  284.  
  285. header  SCSIIcon        
  286.         DC.L $00000000 DC.L $00000000 DC.L $00000000 DC.L $000FF000        
  287.         DC.L $003FFC00 DC.L $00FFFF00 DC.L $01FFFF80 DC.L $03F81FC0        
  288.         DC.L $07E007E0 DC.L $07C003E0 DC.L $0F8001F0 DC.L $0F0000F0 
  289.         DC.L $1F0000F8 DC.L $1E000078 DC.L $1E000078 DC.L $1E000078 
  290.         DC.L $1E000078 DC.L $1E000078 DC.L $1E000078 DC.L $1F0000F8
  291.         DC.L $0F0000F0 DC.L $0F8001F0 DC.L $07C003E0 DC.L $07E007E0
  292.         DC.L $03F80000 DC.L $01FFFFF0 DC.L $00FFFFF8 DC.L $003FFFF8
  293.         DC.L $000FFFF8 DC.L $00000000 DC.L $00000000 DC.L $00000000
  294.         DC.L $00000000 DC.L $00000000 DC.L $000FF000 DC.L $003FFC00
  295.         DC.L $00FFFF00 DC.L $01FFFF80 DC.L $03FFFFC0 DC.L $07FFFFE0
  296.         DC.L $0FFFFFF0 DC.L $0FFFFFF0 DC.L $1FFFFFF8 DC.L $1FFFFFF8
  297.         DC.L $3FFFFFFC DC.L $3FFFFFFC DC.L $3FFFFFFC DC.L $3FFFFFFC
  298.         DC.L $3FFFFFFC DC.L $3FFFFFFC DC.L $3FFFFFFC DC.L $3FFFFFFC
  299.         DC.L $1FFFFFF8 DC.L $1FFFFFF8 DC.L $0FFFFFF0 DC.L $0FFFFFF0
  300.         DC.L $07FFFFF0 DC.L $03FFFFF8 DC.L $01FFFFFC DC.L $00FFFFFC
  301.         DC.L $003FFFFC DC.L $000FFFFC DC.L $00000000 DC.L $00000000
  302.  
  303. \ Our "Where:" string
  304.         DC.B    11
  305.         DC.B    'Q200 (SCSI)'
  306.         .ALIGN
  307.  
  308. \ SCSI handler glue routines
  309. CODE SCSIReset ( -- result code )
  310.     CLR.W -(A7)
  311.     MOVE.W #0,-(A7)
  312.     _SCSIDispatch
  313.     MOVE.W (A7)+,D0
  314.     EXT.L    D0
  315.     MOVE.L D0,-(A6)
  316.     RTS
  317. END-CODE
  318.  
  319. CODE SCSIGet ( -- result code )
  320.     CLR.W -(A7)
  321.     MOVE.W #1,-(A7)
  322.     _SCSIDispatch
  323.     MOVE.W (A7)+,D0
  324.     EXT.L    D0
  325.     MOVE.L D0,-(A6)
  326.     RTS
  327. END-CODE
  328.  
  329. CODE SCSISelect ( TargetID -- SCSIErrorResult )
  330.     MOVE.L (A6)+,D0
  331.     CLR.W -(A7)
  332.     MOVE.W D0,-(A7)
  333.     MOVE.W #2,-(A7)
  334.     _SCSIDispatch
  335.     MOVE.W (A7)+,D0
  336.     EXT.L    D0
  337.     MOVE.L D0,-(A6)
  338.     RTS
  339. END-CODE
  340.  
  341. CODE SCSICmd ( buffer count -- SCSIErrorResult )
  342.     MOVE.L (A6)+,D0
  343.     MOVE.L (A6)+,D1
  344.     CLR.W -(A7)
  345.     MOVE.L D1,-(A7)
  346.     MOVE.W D0,-(A7)
  347.     MOVE.W #3,-(A7)
  348.     _SCSIDispatch
  349.     MOVE.W (A7)+,D0
  350.     EXT.L    D0
  351.     MOVE.L D0,-(A6)
  352.     RTS
  353. END-CODE
  354.  
  355. CODE SCSIComplete ( waitTicks mess stat -- SCSIErrorResult )
  356.     CLR.W -(A7)
  357.     MOVE.L (A6)+,-(A7)
  358.     MOVE.L (A6)+,-(A7)
  359.     MOVE.L (A6)+,-(A7)
  360.     MOVE.W #4,-(A7)
  361.     _SCSIDispatch
  362.     MOVE.W (A7)+,D0
  363.     EXT.L    D0
  364.     MOVE.L D0,-(A6)
  365.     RTS
  366. END-CODE
  367.  
  368. 1 CONSTANT SCInc    2 CONSTANT SCnoInc
  369. 3 CONSTANT SCAdd    4 CONSTANT SCMove
  370. 5 CONSTANT SCLoop    6 CONSTANT SCNop
  371. 7 CONSTANT SCStop    8 CONSTANT SCComp
  372.  
  373. \ ———————————————————————————————
  374. \ main driver routines start here
  375. \ ———————————————————————————————
  376.  
  377. : SCSICommon 
  378.         \ written to emulate the SCSICommon 
  379.         \ routine in Apple's example 
  380.         \ as closely as possible.
  381.     { pseudo cmdblock ourVars ticks bytes cmdsize 
  382.         | writing mess stat -- result }
  383.  
  384.     SCSIGet 0= IF
  385.         ourVars ourID + w@ 
  386.         SCSISelect 0= IF
  387.             cmdBlock cmdSize SCSICmd 0= bytes AND IF
  388.                 pseudo bytes 0< \ bytes <0 if writing
  389.                 IF (call) SCSIWrite drop
  390.                 ELSE (call) SCSIRead drop THEN
  391.         \ Note: Your system may be able to support blind transfers.
  392.         \ Here is the place to experiment with such things ---
  393.             THEN
  394.             ticks ^ mess ^ stat SCSIComplete
  395.             0= IF  
  396.                 stat $FF AND IF ioErr ( there was an SCSI error )
  397.                     ELSE 0 ( successful completion ) THEN
  398.             ELSE ( complete unsuccessful ) ioErr
  399.             THEN
  400.         ELSE ( select unsuccessful ) ioErr
  401.         THEN
  402.     ELSE ( get unsuccessful ) ioErr
  403.     THEN
  404. ;
  405.  
  406. : DiskClose { parblk dce | -- result }
  407.     0 ( result code = OK ) ;
  408.  
  409. : diskControl { parblk dce | ourVars -- result }
  410.     dce DCtlStorage + @ -> ourVars                
  411.     parblk csCode + w@
  412.     CASE
  413.         killCode    OF    0 ENDOF
  414.         verifyCode    OF    0 ENDOF
  415.         formatCode    OF    0 ENDOF
  416.  
  417.         ejectCode    OF
  418.             ourVars MyDrvNum + w@         \ check drive # in request
  419.             parblk  IOVRefNum + w@ =     \ the same?
  420.             IF
  421.                 SysEvtMask w@ IF ( we're not at boot time )
  422.                     DiskInsertEvt
  423.                     MyDrvNum ourVars + w@
  424.                     (call) PostEvent drop
  425.                     ELSE ( boot time )
  426.                     1 ourVars tickleFlag + c!
  427.                     ( drive will be remembered after boot )
  428.                     THEN
  429.                 controlErr
  430.             ELSE nsDrvErr
  431.             THEN
  432.             ENDOF
  433.  
  434.         iconCode OF ['] SCSIIcon parblk csParam + ! 
  435.             0 ENDOF
  436.  
  437.         accRun OF
  438.             ourVars tickleFlag + c@ 
  439.             ourVars offset + @ 0= not 
  440.                 ( we have a good partition )
  441.                 AND
  442.                 IF 
  443.                 DiskInsertEvt
  444.                 MyDrvNum ourVars + w@
  445.                 (call) PostEvent drop
  446.                 THEN
  447.             0 dce DCtlDelay + w!
  448.             dce DCtlFlags + dup w@ 
  449.                 dNeedTime AND swap w! ( clear flag )
  450.             0 ourVars tickleFlag + c!
  451.             0 ENDOF
  452.  
  453.         scsiCode OF
  454.             parblk     dup DSCPseudo + @
  455.                     dup DSCCmd + @
  456.                         ourVars
  457.                     dup DSCTicks + @
  458.                     dup DSCSize + @
  459.                         DSCCmdSize + w@
  460.             SCSICommon
  461.             ENDOF
  462.  
  463.         ( otherwise ) 
  464.         controlErr
  465.     ENDCASE
  466. ;
  467.  
  468. : DiskStatus { parblk dce | -- result } statusErr ;
  469.  
  470. CODE GetSysPtr
  471.     move.l    (a6)+,d0
  472.     _newptr,sys,clr
  473.     move.l    a0,-(a6)
  474.     rts
  475. END-CODE    
  476.  
  477. CODE AddDrv ( dqe refnum drv# | -- )
  478.     move.l    (a6)+,d0
  479.     move.l    (a6)+,d1
  480.     swap.w    d0
  481.     move.w    d1,d0
  482.     move.l    (a6)+,a0
  483.     _AddDrive
  484.     rts
  485. END-CODE
  486.     
  487. : DiskOpen { parblk dce | 
  488.         ourVars thisQElem driveNum dqe SCSIprog -- result }
  489.  
  490.     DiskVarLth GetSysPtr dup         \ get memory for local variables 
  491.     -> ourVars dce DCtlStorage + !     \ and store pointer to it        
  492.     100 5 DO                        \ find unused drive #
  493.         DrvQHdr QHead + @ -> thisQElem    \ scan queue
  494.         BEGIN thisQElem 0= IF i leave THEN    
  495.                         \ end of queue? we have a good number
  496.             thisQElem DQDrive + w@
  497.             i <> WHILE    \ keep scanning as long as # is not in use
  498.             thisQElem ( QLink + ) @ -> thisQElem
  499.         REPEAT
  500.     LOOP    -> driveNum    
  501.     driveNum ourVars myDrvNum + w! \ remember drive # in local vars
  502.  
  503. \ Add a drive to the drive queue. First, some fun facts:
  504. \ 
  505. \ The drive queue element starts four bytes before the DQEPtr! These
  506. \ four bytes contain "hardware-locked", "ejectable", and "disk-in-place" info.
  507. \ 
  508. \ Not As Interesting But Still True: HFS supports volumes >32MBytes, 
  509. \ but since the dqDrvSize field in the DQE is only a word, the Software Gurus
  510. \ had to resort to bizarre sorcery: If the qType field (formerly unused in
  511. \ DQE's) is 1, the word following the dqDriveSize field is assumed to be
  512. \ the high-order word of a LongInt block count! (dqDriveSize is still the low-
  513. \ order word). It works even if the size doesn't require both words,
  514. \ so we always do it this way.
  515. \
  516. \ See: Tech Note #36.
  517.          
  518.     ourVars MyDQEl + 8 over w!    \ set non-ejectable and clear the rest
  519.         2+ 0 over w! 2+    -> dqe    \ this is the real start of the DQElem
  520.  
  521.     1 dqe qType +    w!    \ large vol queue type
  522.     0 dqe dqDrvSize + !    \ no size yet
  523.     0 dqe dQFSID + w!    \ normal file system
  524.  
  525.     dqe 
  526.     dce DCtlRefNum + w@ 
  527.     driveNum    AddDrv    \ add drive to queue
  528.     
  529.     \ now set up the SCSI pseudo program in driver's local vars
  530.  
  531.     ourVars SCSIPseudo +  -> SCSIprog
  532.     scnoinc SCSIprog w!
  533.     scstop  SCSIprog scsize + w!
  534.     0 \ result code = good
  535. ;
  536.  
  537. : DiskPrime { parblk dce | 
  538.         ourVars sectors bytes start size r/w sect transferred error -- result } 
  539.  
  540.     dce dCtlStorage + @ -> ourVars    \ setup local var pointer
  541.     1 ourVars TickleFlag + c!
  542.  
  543.     \ convert byte count into number of sectors
  544.     parblk IOReqCount + @ 9 shr $1FFFFF AND -> sectors
  545.     \ convert starting position into sector number
  546.     dce dCtlPosition + @ 9 shr $1FFFFF AND -> start
  547.     
  548.     ourVars realSize + @ xchg -> size \ get drive size
  549.     start sectors + size 1+ < IF ( valid request )
  550.         0 -> transferred
  551.         ourVars ( offset + ) @ +> start \ offset by start of partition
  552.  
  553.         parBlk IOTrap+1 + c@ 3 = ( is this a write command? )
  554.         IF  -1 -> r/w $2A00 ( SCSI extended write )
  555.         ELSE 1 -> r/w $2800 ( SCSI extended read ) 
  556.         THEN
  557.             ourVars SCmd + w!    \ put the command away 
  558.  
  559.         BEGIN ( transfer loop )
  560.  
  561.         \ If you have problems getting the SCSI transfer to work
  562.         \ with your particular disk, try changing the number of
  563.         \ sectors transferred on each call ( 127 here )
  564.         \ or change the read/write extended to a normal read/write.
  565.         \ Note that in that case you'll have to change the command 
  566.         \ block setup as well. 
  567.  
  568.         127 sectors min -> sect
  569.         transferred +> start
  570.         parblk IOBuffer + @ transferred 9 shl + 
  571.             ourVars SCSIPar1 + ! 
  572.         sect 9 shl dup -> bytes 
  573.             ourVars SCSIPar2 + !    \ set # of bytes
  574.  
  575.         start ourVars SCmd + 2+ !    
  576.                 \ set starting position in command block
  577.         bytes 2/ ourVars SCmd + 6 + !    \ set # of sectors
  578.         
  579.         IOErr ( preset, in case loop with retry is unsuccessful )
  580.         10 0 DO ( retry max 10 times )
  581.         ourVars SCSIPseudo +
  582.             ourVars SCmd +
  583.             ourVars 60 r/w 10
  584.             SCSICommon 0= IF drop 0 leave THEN
  585.         1 (call) sysbeep \ just for debugging, 
  586.             \ beeps if SCSI did not complete successfully
  587.         LOOP -> error
  588.  
  589.         -127 +> sectors
  590.         sectors 1- 0< 
  591.         UNTIL ( transfer loop )
  592.  
  593.         error dup 0= IF
  594.             parBlk IOReqCount + @ -> bytes
  595.             bytes parBlk IOActCount + ! 
  596.                     \ we transferred the # of bytes requested
  597.             bytes dce DCtlPosition + +!
  598.         THEN
  599.  
  600.     ELSE IOErr
  601.     THEN            
  602. ;
  603.  
  604. CODE DrvrInst ( unitNum | -- )
  605.     move.l    (a6)+,d0
  606.     not.w    d0
  607.     _DrvrInstall
  608.     rts
  609. END-CODE
  610.     
  611. CODE DrvrRem ( unitNum | -- )
  612.     move.l    (a6)+,d0
  613.     not.w    d0
  614.     _DrvrRemove
  615.     rts
  616. END-CODE
  617.  
  618. CODE openMe ( drvrName | result -- )
  619.     \ allocates a parameter block on the A7 stack and calls
  620.     \ the _open trap. This is easier to do in assembly ---
  621.     moveq.l    #(IOParamBlkSize/2)-1,d0
  622. @1    clr.w    -(a7)
  623.     dbra    d0,@1
  624.     move.l    a7,a0
  625.     move.l    (a6)+,IONamePtr(a0)
  626.     _Open
  627.     add.w    #IOParamBlkSize,a7
  628.     move.l    d0,-(a6)
  629.     rts
  630. END-CODE
  631.  
  632. : RealInstall 
  633.     \ This routine is called by the system boot code with 
  634.     \ the SCSI ID of the disk in D5 and a pointer to its
  635.     \ partition map in A0. We therefore need some special glue code. 
  636.     \ Note that Mach2 allows to do the stack parameter / local
  637.     \ variable declaration after this glue code without any problems
  638.     LINK    A6,#-512         ( 512 bytes of local Forth stack )
  639.     MOVEM.L A2-A6/D2-D7,-(A7)        ( save registers )
  640.     MOVE.L  A6,A3            ( setup local loop return stack )
  641.     SUBA.L  #256,A3            ( in the low 256 local stack bytes )
  642.     MOVE.L  A0,-(A6)         ( partition table pointer )
  643.     MOVE.L  D5,-(A6)        ( SCSI ID )
  644.     
  645.     { partition ID | unitNum hdce dce ourVars pt -- }
  646.  
  647.     ID 32 + -> unitNum
  648.     unitNum DrvrInst    \ allocate DCE and install it
  649.     unitNum 4 w* UTableBase @ + @ -> hdce \ dce handle
  650.         hdce @ -> dce    \ get dce pointer
  651.     ['] DiskDrvr dce ( DCtlDriver + ) ! \ put pointer to driver into dce    
  652.     ['] DiskDrvr drvrFlags + w@
  653.         dce DCtlFlags + w!    \ move driver flags, RAMbase should be cleared
  654.     0 dce DCtlDelay + w!        \ no time needed yet
  655.     ['] DiskDrvr drvrEMask + @
  656.         dce DCtlEMask + !    \ move event mask and menu
  657.  
  658.     ['] DiskDrvr drvrName + openMe    \ try to open this driver
  659.         IF ( not OK ) unitNum DrvrRem
  660.            ['] Scsidisk (call) DisposPtr
  661.            bra @1 \ exit hack. 
  662.             \ This is the Mach2 equivalent of the 
  663.             \ Ugly Goto Statement in Pascal. 
  664.             \ Sorry, but it is so much easier this way...
  665.         THEN 
  666.     
  667.     hdce @ -> dce \ deref this handle again, may have changed
  668.     dce dCtlStorage + @ -> ourVars
  669.     ID ourVars ourID + w!
  670.     partition IF 
  671.         \ well, we should have a non-NIL partition at least...
  672.     partition ( PDSig + ) w@ PDSigWord = IF
  673.         \ and it should be a Macintosh one. The NEW Apple drivers
  674.         \ have a different sig word and DPM format that you 
  675.         \ might want to take into account here (see text). 
  676.         partition 2+ -> pt
  677.         BEGIN
  678.         pt PDFSID + @ ?dup WHILE \ otherwise no good partition found
  679.         "tfs1 = 
  680.             IF ( correct file system ID )
  681.                 pt @ ourVars Offset + !
  682.                 pt 4 + @ xchg ( long drive size, hi word <-> lo word )
  683.                     ourVars realSize + !
  684.                 SysEvtMask w@ 0= IF \ we're booting
  685.                     dce dCtlFlags + dup w@ $2000 OR swap w!
  686.                         ( set dNeedTime flag )
  687.                     1 dce dCtlDelay + w!
  688.                     1 ourVars TickleFlag + c!
  689.                     THEN 
  690.             THEN
  691.         12 +> pt
  692.         REPEAT
  693.     THEN THEN
  694.  
  695. @1    UNLK    A2    \ which was used for local variables
  696.     MOVEM.L (A7)+,A2-A6/D2-D7    ( restore registers )
  697.     UNLK    A6
  698.     RTS        \ we stop here; the rest will be inaccessible junk (4 bytes).
  699. ;
  700.     
  701.  
  702. : DrOpen  DA.prelude DiskOpen DA.epilogue ;
  703. : DrClose DA.prelude DiskClose DA.epilogue ;
  704. : DrCtl   DA.prelude DiskControl DA.JIODone  ; 
  705. : DrStatus DA.prelude DiskStatus DA.JIODone ;
  706. : DrPrime DA.prelude DiskPrime DA.JIODone ;
  707.  
  708. ' DrOpen ' DrPrime ' DrCtl ' DrStatus ' DrClose
  709. $6F00 0 0 0 ( flags delay mask menu )
  710. " .SCSIfth" ( name, MUST start with a period ) 
  711. ;DA
  712.  
  713. ' RealInstall ;XDEF
  714.  
  715. \ —————————————————————————————————————————
  716. \ The following routines are to be added or replaced in the 
  717. \ installer program from the previous column. Included is an
  718. \ installer that will directly move the Forth code to disk, without
  719. \ going through a resource, and some code to install the driver 
  720. \ in memory for testing without writing it to the disk. The 
  721. \ DDM and DPM definitions have been changed somewhat to accommodate 
  722. \ the larger driver, and to have the partition start at the same
  723. \ place that Apple's new SCSI driver expects it (so that you can 
  724. \ replace the Forth driver easily by a new Apple driver in case 
  725. \ you are fed up with this hack)
  726. \ Good luck. - JL -
  727. \ —————————————————————————————————————————
  728.  
  729. hex
  730.  
  731. : create.ddm
  732.     ddm 200 0 fill
  733.     4552 ddm w!
  734.     read.cap ddm 2+ w! ( block size )
  735.              ddm 4 + ! ( # of blocks )
  736.     0 ddm 8 + w! ( device type )
  737.     0 ddm A + w! ( device ID )
  738.     10 ddm C + !  ( first data block )
  739.     1 ddm 10 + w! ( one driver to follow )
  740.     4 ddm 12 + ! ( driver start block )
  741.     A ddm 16 + w! ( driver is 10 blocks long )
  742.     1 ddm 18 + w! ( and runs on Macintosh =1 )
  743. ;
  744.  
  745. : create.dpm
  746.     dpm 200 0 fill
  747.     5453 dpm w!
  748.     10 dpm 2+ ! ( starting block of partition )
  749.     read.cap drop 10 - dpm 6 + ! ( # of blocks )
  750.     "tfs1 dpm A + !   ( TFS1 signature )
  751.     0 dpm E + !
  752. ;    
  753.  
  754. decimal
  755.  
  756. : read.ddm
  757.     0 read.blk 2+ w! 0 read.blk 4 + c!
  758.     1 read.blk 5 + c!
  759.     120 read.blk myDisk @ ddm 512 doscsi.r
  760.     2drop
  761. ;
  762.  
  763. : read.dpm
  764.     0 read.blk 2+ w! 1 read.blk 4 + c!
  765.     1 read.blk 5 + c!
  766.     120 read.blk myDisk @ dpm 512 doscsi.r
  767.     2drop
  768. ;
  769.  
  770. : write.ddm
  771.     0 write.blk 2+ w! 0 write.blk 4 + c!
  772.     1 write.blk 5 + c!
  773.     120 write.blk myDisk @ ddm 512 doscsi.w
  774.     2drop
  775. ;
  776.  
  777. : write.dpm
  778.     0 write.blk 2+ w! 1 write.blk 4 + c!
  779.     1 write.blk 5 + c!
  780.     120 write.blk myDisk @ dpm 512 doscsi.w
  781.     2drop
  782. ;
  783.  
  784. : get.sdrv { | length -- length } 
  785.     ['] scsidisk dup 
  786.     xlen dup -> length driver.block swap cmove
  787.     length
  788. ;
  789.  
  790. : write.sdrv { length | sectors }
  791.     0 write.blk 2+ w! 4 write.blk 4 + c!
  792.     length 512 / 1+ dup write.blk 5 + c! -> sectors
  793.     120 write.blk myDisk @ driver.block sectors 512 * doscsi.w
  794.     cr ." Driver written. Stat, Mess = " . .
  795. ;
  796.  
  797. : dmp { block# | -- } ( for easy testing of SCSI disk contents )
  798.     0 read.blk 2+ w! block# read.blk 4 + c!
  799.     1 read.blk 5 + c!
  800.     120 read.blk myDisk @ ddm 512 doscsi.r
  801.     2drop
  802.     ddm 20 dump
  803. ;
  804.     
  805.  
  806. .TRAP   _newptr,sys     $A51E
  807. $308 CONSTANT DQHeader
  808. 6 CONSTANT QTail
  809.  
  810. VARIABLE syshp.drvr
  811.  
  812. : install.driver { | dstart dlength dbytes pointer -- }
  813.     read.ddm 
  814.     ddm 18 +  @ -> dstart
  815.     ddm 22 + w@ -> dlength
  816.     cr ." Driver starts at sector " dstart .
  817.     ."  and is " dlength . ."  sectors long."
  818.     dlength 512 * -> dbytes
  819.     dstart 256 /mod read.blk 2+ w! read.blk 4 + c!
  820.     dlength read.blk 5 + c!
  821.     120 read.blk myDisk @ driver.block dbytes doscsi.r
  822.     cr ." Driver read; stat, mess = " . .
  823.     dbytes    MOVE.L (A6)+,D0
  824.         _newptr,sys ( get memory block in system heap )
  825.         MOVE.L A0,-(A6)     -> pointer
  826.     pointer 
  827.     IF    driver.block pointer dbytes cmove
  828.         pointer syshp.drvr !
  829.         ELSE ." Not enough system heap for installation." cr
  830.         THEN
  831. ;
  832.  
  833. CODE call.driver
  834.     MOVE.L D5,-(A7)
  835.     MOVE.L (A6)+,D5
  836.     MOVE.L (A6)+,A0
  837.     execute
  838.     MOVE.L (A7)+,D5
  839.     RTS
  840. END-CODE
  841.  
  842. : mount.scsi
  843.     install.driver 
  844.     read.dpm
  845.     SysEvtMask @
  846.     0 SysEvtMask !
  847.     syshp.drvr @ dpm myDisk @ call.driver
  848.     SysEvtMask !
  849. ;
  850.  
  851. : zero.scsi 
  852.     DQHeader qTail + @ dQDrive + w@ ( drive # found )
  853.     cr ." Do you want to zero the directory of drive # " dup . ."  ? "
  854.     yesno if " JL's Hard Disk" call DIZero
  855.             cr ." Result code = " . cr 
  856.     then
  857. ;
  858.     
  859.  
  860. : mount 
  861.     cr ." Looking for SCSI devices..."
  862.     get.disk
  863.     cr ." SCSI drive found at address " myDisk @ .
  864.     cr show.cap
  865.     cr ." format disk? " 
  866.     yesno IF cr ." Do you REALLY want to erase this SCSI disk? "
  867.         yesno IF cr ." Reformatting disk... " 
  868.                  format 
  869.               THEN
  870.         THEN
  871.     modenoattn
  872.     create.ddm    create.dpm
  873.     write.ddm    write.dpm
  874.     cr ." Device and partition descriptor maps written. "
  875.     get.sdrv
  876.     cr ." Writing driver ... "
  877.     write.sdrv
  878.     mount.scsi
  879.     zero.scsi 
  880. ;
  881.  
  882. : install.mem { | dbytes pointer -- }
  883.     get.sdrv
  884.     ['] scsidisk xlen dup -> dbytes
  885.     MOVE.L (A6)+,D0
  886.         _newptr,sys ( get memory block in system heap )
  887.         MOVE.L A0,-(A6)     -> pointer
  888.     pointer 
  889.     IF    driver.block pointer dbytes cmove
  890.         pointer syshp.drvr !
  891.         ELSE ." Not enough system heap for installation." cr
  892.         THEN
  893. ;
  894.  
  895. : mount.mem
  896.     install.mem
  897.     read.dpm
  898.     SysEvtMask @
  899.     0 SysEvtMask !
  900.     syshp.drvr @ dpm myDisk @ call.driver
  901.     SysEvtMask !
  902. ;
  903.  
  904.